#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}

package require Tk

wm title . "Tclyzer"
#wm iconimage . "Loader.ico"

frame .fr
pack .fr -fill both -expand 1
bind .fr <Configure> { resizeWindow }

set width 800
set height 400
set x [expr { ( [winfo vrootwidth  .] - $width  ) / 2 }]
set y [expr { ( [winfo vrootheight .] - $height ) / 2 }]
wm geometry . ${width}x${height}+${x}+${y}

frame .fr.pnl -relief groove -borderwidth 1
pack  .fr.pnl -fill both -expand 1

label  .fr.lpins -width 4 -height 1 -text "Show"
pack   .fr.lpins -padx 1 -pady 6 -side left
text   .fr.pins  -width 9 -height 1
pack   .fr.pins  -padx 1 -pady 3 -side left

label  .fr.larm  -width 3 -height 1 -text "Arm"
pack   .fr.larm  -padx 1 -pady 6 -side left
text   .fr.arm   -width 9 -height 1
pack   .fr.arm   -padx 1 -pady 3 -side left

label  .fr.ltrig -width 4 -height 1 -text "Trig"
pack   .fr.ltrig -padx 1 -pady 6 -side left
text   .fr.trig  -width 9 -height 1
pack   .fr.trig  -padx 1 -pady 3 -side left

label  .fr.lsize -width 7 -height 1 -text "Samples"
pack   .fr.lsize -padx 1 -pady 6 -side left
text   .fr.size  -width 5 -height 1
pack   .fr.size  -padx 1 -pady 3 -side left

label  .fr.lrate -width 6 -height 1 -text "RateHz"
pack   .fr.lrate -padx 1 -pady 6 -side left
text   .fr.rate  -width 7 -height 1
pack   .fr.rate  -padx 1 -pady 3 -side left

.fr.pins insert end "FF000000"
.fr.arm  insert end "F0000000"
.fr.trig insert end "F0000000"
.fr.size insert end "512"
.fr.rate insert end "710000"

# debug only
#text   .fr.adj   -width 3 -height 1
#pack   .fr.adj   -padx 1 -pady 6 -side left
#.fr.adj insert end "10"

set vertadj 10


# ###############################################################
# Display the bitstream as a 1/0 graph on a line.
# As in many computer graphics systems, x,y origin is at top left.
# x = colstart + n*size
# y = rowstart + size - bit*size
#
font create .sigfont -family Courier
proc display { len name row col xsize ysize output nstart } {
    global vertadj
    set y   [expr $row*$ysize+$ysize + $ysize+$vertadj]
    font configure .sigfont -size [expr $ysize-$ysize/5]
    .fr.pnl.can create text 50 [expr $y+$ysize/10] -font .sigfont -text $name
    set x1  [expr $col+$xsize]
    set x2  [expr $col+$xsize+$len*$xsize]
    set t   [expr $row*$ysize+$ysize + $ysize/2 + $vertadj]
    set b   [expr $row*$ysize+$ysize + $ysize/2 + $ysize + $vertadj]
    .fr.pnl.can create rectangle $x1 $t $x2 $b -fill "light gray" -outline white
    set end [expr $len+$nstart]
    for { set n $nstart } { $n < $end } { incr n } {
        set bit [string index $output $n]
        #if { $bit != 0 && $bit != 1 } { puts "At $n of $end Display What? '$bit'"; return }
        set x   [expr $col+$xsize+($n-$nstart)*$xsize]
        set y   [expr $row*$ysize+$ysize-$bit*($ysize-$ysize/3)+$ysize/3 + $ysize+$vertadj]
        if { $n == $nstart } { set old $y }
        .fr.pnl.can create line $x $old $x $y -fill black
        .fr.pnl.can create line $x $y [expr $x+$xsize] $y -fill black
        set old $y
    }
}

# ###############################################################
# Display the column header for signals.
#
font create .headfont -family Ariel -size 11
proc header { len name row col xsize ysize nstart } {
    global vertadj
    set y   [expr $row*$ysize + $ysize+$vertadj]
    #font configure .headfont -size [expr $ysize/5]
    .fr.pnl.can create text 50 $y -font .headfont -text $name
    for { set n $nstart } { $n < [expr $len+$nstart] } { incr n } {
        set x   [expr $col+$xsize+($n-$nstart)*$xsize]
        if { [expr $n % 10 ] == 0 } {
            .fr.pnl.can create text $x [expr $row*$ysize + $ysize+$vertadj] -text [expr $n]
        } else {
            if { [expr $n%10 ] != 1 && [expr $n%10 ] != 2 && [expr $n%10 ] != 8 && [expr $n%10 ] != 9 } {
                .fr.pnl.can create text $x [expr $row*$ysize + $ysize+$vertadj] -text "-"
            }
        }
    }
}

# ###############################################################
# show output of capture
#
proc showOutput { output } {
    set sigpix 100
    set lim 101
    set len [string length $output]
    if { $len < $lim } { set lim $len }

    .fr.pnl.can delete "all"

    set winHeight [.fr.pnl.can cget -height]
    set winWidth  [.fr.pnl.can cget -width]

    # split uses "\r\n\t " by default
    set lines [split $output "\r\n"]
    set linecount [expr [llength $lines] -1]
    #puts $linecount
    set rowpad [expr ($winHeight)/($linecount+2)]

    set colpad  [expr ($winWidth)/($lim+10)]
    set start 0

    set line [split [lindex $lines 1] " "]
    set lineNumber [string trim [lindex $line 0]]
    set pattern [string trim [lindex $line 1]]
    #puts "$lineNumber=$pattern"
    set len [string length $pattern]
    header  $len "Tick/Signal" 0 $sigpix $colpad $rowpad $start

    for { set n 1 } { $n < $linecount } { incr n } {
        set line [split [lindex $lines $n] " "]
        set lineNumber [string trim [lindex $line 0]]
        set pattern [string trim [lindex $line 1]]
        #puts "$lineNumber=$pattern"
        set len [string length $pattern]
        display $len $lineNumber $n $sigpix $colpad $rowpad $pattern $start
        update idletasks
    }

}

# ###############################################################
# download
#
proc download { } {

    global appid
    global port

    # make sure to draw the windows
    update idletasks

    global progress
    set progress 2
    .fr.prog configure -variable progress

    set file "analyzer.elf"
    set appid [open "|./propeller-load -r $file" RDWR]
    fconfigure $appid -translation { auto auto }
    after 200

    set bytes 0
    set port 0
    while { [eof $appid] == 0 } {
        after 50
        set len [gets $appid output]
        #puts "$len :: $output" ;# debugging $bytes problem ... added catch [expr]

        if {[regexp "CMD>" $output]} {
            puts $output
            break
        } elseif {[regexp "Propeller" $output]} {
            puts $output
            set port $output
            set progress 4
            continue
        } elseif {[regexp "Loading" $output]} {
            puts $output
            set progress 6
            continue
        } elseif {[regexp "Verifying" $output]} {
            puts $output
            set progress 95
            continue
        } elseif {[regexp "bytes" $output]} {
            if { $bytes == 0 } {
                set s [split $output]
                set bytes [lindex $s 0]
                # ignore stupid Quickstart garbage
                if { $bytes == "Ignored"} {
                    puts $output
                    set bytes 0
                }
            } else {
                # ignore stupid Quickstart garbage
                if { $bytes == "Ignored"} {
                    puts $output
                    continue
                }
                set s [split $output]
                set curbytes [lindex $s 0]
                set amount   [expr 100-(100*$curbytes/$bytes)]
                if { $amount != 0 } {
                    set progress $amount
                }
            }
            continue
        } elseif {[regexp "ESC" $output]} {
            puts $output
            continue
        } elseif {[regexp "error" $output]} {
            set progress 100
            tk_messageBox -message $output
            return
        }
    }
    set progress 96
    puts "Download Complete."

    set mylist [split $port]
    set ndx [expr [llength $port]-1]
    set port [lindex $port $ndx]

    # Use the serial port found by propeller-load.
    # Adjust to windows if not a /dev ....
    #
    if {[regexp "/dev/" $port] == 0} {
        set port "\\\\.\\$port"
    }
    puts "Using serial port $port"

    # Would like to open serial port here ....
    # We can't globally open the serial port ... no idea why not.
    # PUNT! Only open the port in the function where it's used.
    #
    set progress 100
    after 1000

    .fr.goat configure -state normal
    .fr.goto configure -state normal
    .fr.ping configure -state normal
}
  
# ###############################################################
# config serial
#
proc configSerial { serial } {
    fconfigure $serial -mode "115200,n,8,1"
    #fconfigure $serial -blocking 1 ;# default is blocking
    fconfigure $serial -handshake none
    fconfigure $serial -buffering none
    fconfigure $serial -translation { auto lf } ;#analyzer wants LF
}

# ###############################################################
# send command 
#
proc sendStr { str } {
    global serial
    set len [string length $str]
    for { set n 0 } { $n < $len } { incr n } {
        set ch [string index $str $n]
        puts -nonewline $serial $ch
        #puts -nonewline $ch
	after 20
    }
}

# ###############################################################
# send serial command 
#
proc sendSerial { serial cmd } {

    sendStr $cmd
    puts $cmd
    puts -nonewline $serial "\r"

    set retString ""

    while { 1 == 1 } {
	after 50
        set len [gets $serial output]
        if { $len < 2 } {
            continue
        }
        if {[regexp "CMD>" $output] == 0} {
            append retString "$output\n"
        }
        if {[regexp "CMD>" $output]} {
            puts $output
            return $retString
        }
    }
    return $retString
}

# ###############################################################
# real capture
#
proc capture { type } {
  
    global serial
    global serialopen
    global port

    # For some reason, if we open this globally and try to use it here the
    # commands get out of sequence. The serialopen hack gets around that.
    #
    if { $serialopen == 0 } {
        set serial [open $port r+]
        configSerial $serial
        set serialopen 1
    }

    fconfigure $serial -timeout 1000

    set value [string trim [.fr.pins get 1.0 end]]
    sendSerial $serial "pins $value"

    set value [string trim [.fr.arm get 1.0 end]]
    sendSerial $serial "arm $value"

    set value [string trim [.fr.trig get 1.0 end]]
    sendSerial $serial "trig $value"

    set value [string trim [.fr.size get 1.0 end]]
    if { $value > 4096 } {
        set value 4096
    }
    set value [format %X $value]
    sendSerial $serial "size $value"

    set value [string trim [.fr.rate get 1.0 end]]
    set value [format %X $value]
    sendSerial $serial "rate $value"

    if { $type } {
        sendSerial $serial "goat"
    } else {
        sendSerial $serial "goto"
    }
    sendSerial $serial "info"
    set output [sendSerial $serial "dump"]
    showOutput $output
    resizeWindow
}

# ###############################################################
# ping analyzer
#
proc pinga { } {
  
    global serial
    global serialopen
    global port

    if { $serialopen == 0 } {
        set serial [open $port r+]
        configSerial $serial
        set serialopen 1
    }
    set rets [sendSerial $serial ""]   ;#is it alive?
    puts $rets
    
}

# ###############################################################
# resizeWindow
#
proc resizeWindow { } {
    set geo [wm geometry .]
    set  geos [split $geo "+"]
    set  dims [split [lindex $geos 0] "x"]
    set  width  [lindex $dims 0]
    set  height [lindex $dims 1]
    #puts "$width $height"

    set canwidth [expr $width-20]
    set canheight [expr $height-60]
    .fr.pnl.can configure -background "light gray" -borderwidth 5 -width $canwidth -height $canheight -scrollregion "0 0 $canwidth $canheight" -xscrollcommand { .fr.pnl.h set }
    .fr.pnl.h configure -orient horizontal -command { .fr.pnl.can xview }
    pack   .fr.pnl.can
    pack   .fr.pnl.h -side bottom -fill x
    .fr.pnl.can configure -scrollregion [.fr.pnl.can bbox all]
}

# ###############################################################
# widgets
#
set canwidth [expr $width-20]
set canheight [expr $height-60]
canvas .fr.pnl.can -background "light gray" -borderwidth 5 -width $canwidth -height $canheight -scrollregion "0 0 $canwidth $canheight" -xscrollcommand { .fr.pnl.h set }
scrollbar .fr.pnl.h -orient horizontal -command { .fr.pnl.can xview }
pack   .fr.pnl.can
pack   .fr.pnl.h -side bottom -fill x
.fr.pnl.can configure -scrollregion [.fr.pnl.can bbox all]

bind .fr.pnl.can <1> {set lastx [.fr.pnl.can canvasx %x]; set lasty [.fr.pnl.can canvasy %y]}

#ttk::button .fr.cancel -text "Cancel"
#pack .fr.cancel -padx 5 -pady 5 -side right

button .fr.quit     -width 4 -text "Quit" -command {
    global serialopen
    if { $serialopen != 0 } {
        close $serial
    }
    exit
}
pack   .fr.quit     -padx 1 -pady 2 -side right

button .fr.goat  -width 2 -state disabled -text "t>" -command {
    #if {[catch capture $height $width]} { tk_messageBox -message "Error during capture." }
    capture 1
}
pack .fr.goat    -padx 1 -pady 2 -side right

button .fr.goto  -width 2 -state disabled -text ">t" -command {
    #if {[catch capture $height $width]} { tk_messageBox -message "Error during capture." }
    capture 0
}
pack .fr.goto    -padx 1 -pady 2 -side right

ttk::progressbar .fr.prog -orient horizontal -length 30 -mode determinate
pack    .fr.prog -padx 2 -side right

button .fr.download -width 4 -text "Load" -command {
    #if {[catch download ]} { tk_messageBox -message "Error during downoad."}
    download
}
pack .fr.download   -padx 1 -pady 2 -side right

button .fr.ping -width 1 -state disabled -text "!" -command {
    #if {[catch pinga ]} { tk_messageBox -message "Error during ping."}
    pinga
}
pack .fr.ping   -padx 1 -pady 2 -side right

##########################################################################
# This is the last bits of start-up. Everything else is event driven.
#
update idletasks
set serialopen 0
#if {[catch download ]} { tk_messageBox -message "Error during downoad." ; exit }

